home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 5.6 KB | 149 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 2 Feb 95
- Syntax10b.Scn.Fnt
- MODULE DialogColorPickers;
- (** Markus Knasm
- ller 16 Sep.94 -
- IMPORT Bitmaps, DialogFrames, Dialogs, DialogTexts, Display, Display1, GraphicUtils, In, Input, Oberon, TextFrames, Texts, Viewers;
- CONST W* = 20; H* = W; ML = 0; MM = 1; MR = 2; cancel = {ML, MM, MR}; black = 15;
- TYPE
- Item* = POINTER TO ItemDesc;
- ItemDesc* = RECORD(Dialogs.ObjectDesc)
- col*: INTEGER; (** selected color *)
- END;
- PROCEDURE Box (x, y, w, h: INTEGER);
- VAR i: INTEGER;
- BEGIN
- FOR i := 0 TO w DO
- Display.Dot (black, x + i, y, Display.invert);
- Display.Dot (black, x + i, y + h, Display.invert)
- END;
- FOR i := 1 TO h - 1 DO
- Display.Dot (black, x, y + i, Display.invert);
- Display.Dot (black, x + w, y + i, Display.invert)
- END
- END Box;
- PROCEDURE (c: Item) Draw* (x, y: INTEGER; f: Display.Frame);
- (** displays the object at (x, y) in frame f *)
- VAR x0, y0, w, h, mode: INTEGER;
- BEGIN
- c.GetDim (x0, y0, w, h); DEC (w); DEC (h);
- IF c.selected THEN mode := Display.invert ELSE mode := Display.paint END;
- Display1.Line (f, black, x, y, x + w, y, mode); Display1.Line (f, black, x + w, y, x + w, y + h, mode);
- Display1.Line (f, black, x, y, x, y + h, mode); Display1.Line (f, black, x, y + h, x + w, y + h, mode);
- Display.ReplConstC (f, c.col, x + 1, y + 1, w - 1, h - 1, mode)
- END Draw;
- PROCEDURE (c: Item) Print* (x, y: INTEGER);
- (** prints the object at printer coordinates (x, y) *)
- VAR x0, y0, w, h: INTEGER;
- BEGIN
- c.GetPDim (x0, y0, w, h);
- GraphicUtils.PrintBox (x, y, w, h)
- END Print;
- PROCEDURE (c: Item) Copy* (VAR dup: Dialogs.Object);
- (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
- VAR x: Item;
- BEGIN
- IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END;
- c.Copy^ (dup); x.col := c.col;
- END Copy;
- PROCEDURE (c: Item) Show (x, y, w, h: INTEGER; VAR col: INTEGER; VAR keysum: SET);
- VAR mx, my, top, bot, left, right, newcol: INTEGER; b: Bitmaps.Bitmap; keys: SET;
- PROCEDURE Flip (col: INTEGER);
- VAR x0, y0: INTEGER;
- BEGIN
- IF col >= 0 THEN
- x0 := x + (col MOD 4) * (w DIV 4); y0 := y + h - ((col DIV 4) + 1) * (h DIV 4);
- Box (x0, y0, w DIV 4, h DIV 4)
- END
- END Flip;
- PROCEDURE DrawColors (x, y, w, h: INTEGER);
- VAR c, i, j: INTEGER;
- BEGIN
- FOR i := 0 TO 3 DO
- FOR j := 0 TO 3 DO
- c := i * 4 + j;
- Display.ReplConst (c, x + (c MOD 4) * w, y + (3 - (c DIV 4)) * h, w, h, Display.paint)
- END
- END
- END DrawColors;
- BEGIN
- left := x + 1; right := x + w - 2; bot := y + 1; top:= y + h - 2; col := c.col;
- Oberon.RemoveMarks (x, y, w, h); Oberon.FadeCursor(Oberon.Mouse);
- (* save background *)
- b := Bitmaps.New (w + 1, h + 1); Bitmaps.CopyBlock (Bitmaps.Disp, b, x, y, w + 1, h + 1, 0, 0, 0);
- DrawColors (x, y, w DIV 4, h DIV 4);
- REPEAT
- Input.Mouse (keys, mx, my); keysum := keysum + keys;
- Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, mx, my);
- IF keysum = cancel THEN col := -1
- ELSIF (mx >= left) & (mx <= right) & (my >= bot) & (my <= top) THEN
- newcol:= 4* ((top - my) DIV (h DIV 4)) + (mx - left) DIV (w DIV 4);
- IF newcol # col THEN
- Flip(col); Flip(newcol); col:=newcol
- END
- ELSE Flip(col); col := -1
- END
- UNTIL keys = {};
- Oberon.FadeCursor(Oberon.Mouse);
- (* restore background *)
- Bitmaps.CopyBlock (b, Bitmaps.Disp, 0, 0, w + 1, h + 1, x, y, 0);
- END Show;
- PROCEDURE (c: Item) Track (x, y: INTEGER; keys: SET; f: Display.Frame; p: Dialogs.Panel);
- VAR t: Texts.Text; ox, oy, ow, oh, col: INTEGER;
- BEGIN
- IF (keys = {MM}) OR (keys = {ML}) OR (keys = {MR}) THEN
- c.GetDim (ox, oy, ow, oh);
- ox := f.X + ox; oy := f.Y + f.H + oy; ow := 4 * ow; oh := 4 * oh;
- oy := oy - oh; IF (oy < 0) THEN oy := oy + oh * 5 DIV 4 + 1 ELSE DEC (oy) END;
- IF ox + ow > Display.Width THEN ox := ox - ow + ow DIV 4 END;
- c.Show (ox, oy, ow, oh, col, keys);
- IF (col # c.col) & (col >= 0) THEN
- c.col := col; c.Restore;
- IF c.cmd[0] # 0X THEN
- DialogTexts.GetParText (c.par, c.panel, t);
- c.CallCmd (f, Viewers.This (x, y), t)
- END
- END
- ELSE Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
- END
- END Track;
- PROCEDURE (c: Item) Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
- (** handles messages which were sent to frame f *)
- BEGIN
- c.Handle^ (f, m);
- WITH f: DialogFrames.Frame DO
- WITH m: Oberon.InputMsg DO
- IF m.id = Oberon.track THEN c.Track (m.X, m.Y, m.keys, f, f.panel) END
- ELSE
- END
- ELSE
- END
- END Handle;
- PROCEDURE Insert*;
- (** Insert ([name] [x y w h] | ^ ) inserts a colorpicker - item in the panel containing the caret position *)
- VAR x, y, x1, y1, w, h: INTEGER; c: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR;
- BEGIN
- NEW (c);
- DialogFrames.GetCaretPosition (p, x, y);
- IF (p # NIL) THEN
- c.Init; c.col := 15; In.Open; In.Name (name);
- IF ~In.Done THEN COPY ("", name); In.Open END;
- c.SetName (name);
- In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
- IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H
- ELSE
- IF w < 0 THEN w := W END;
- IF h < 0 THEN h := H END
- END;
- c.SetDim (x1, y1, w, h, FALSE); p.Insert (c, FALSE)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END;
- IF Dialogs.res # 0 THEN Dialogs.Error ("DialogColorPickers") END;
- END Insert;
- END DialogColorPickers.
-